home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / ifp1s155.zip / PAGE_15.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-21  |  4KB  |  183 lines
  1. unit page_15;
  2.  
  3. interface
  4.  
  5. uses crt, ifpglobl, ifpcomon;
  6.  
  7. procedure page15;
  8.  
  9. implementation
  10.  
  11. procedure page15;
  12.  
  13. var
  14.   i : byte;
  15.   j : 0..3;
  16.   k : byte;
  17.   part : array[0..secsiz - 1] of byte;
  18.   xbool1 : boolean;
  19.   xbool2 : boolean;
  20.   xbool3 : boolean;
  21.   xbool4 : boolean;
  22.   xbyte : byte;
  23.   xlong : longint;
  24.   xword : word;
  25.  
  26.   begin
  27.   caption2('Partition table data');
  28.   i:=$80;
  29.   xbool1:=false;
  30.   xbool2:=false;
  31.   repeat
  32.     with regs do
  33.       begin
  34.       AX:=$0201;
  35.       CX:=$0001;
  36.       DX:=i;
  37.       ES:=seg(part);
  38.       BX:=ofs(part);
  39.       intr($13, regs);
  40.       if nocarry(regs) then
  41.         begin
  42.         xbool1:=true;
  43.         xbool2:=true
  44.         end
  45.       else
  46.         if i < $99 then
  47.           inc(i)
  48.         else
  49.           xbool1:=true
  50.       end
  51.   until xbool1;
  52.   if xbool2 then
  53.     begin
  54.     writeln;
  55.     caption3('Unit');
  56.     writeln;
  57.     caption3('Partition');
  58.     writeln;
  59.     caption3('Bootable');
  60.     writeln;
  61.     caption3('Starting head');
  62.     writeln;
  63.     caption3('Starting sector');
  64.     writeln;
  65.     caption3('Starting cylinder');
  66.     writeln;
  67.     caption3('System ID');
  68.     writeln;
  69.     caption3('Ending head');
  70.     writeln;
  71.     caption3('Ending sector');
  72.     writeln;
  73.     caption3('Ending cylinder');
  74.     writeln;
  75.     caption3('First partition sector');
  76.     writeln;
  77.     caption3('Sectors in partition');
  78.     writeln;
  79.     xbool3:=false;
  80.     repeat
  81.       window(9, 4, twidth, tlength - 2);
  82.       writeln(i);
  83.       window(27, 5, twidth, tlength - 2);
  84.       clrscr;
  85.       for j:=0 to 3 do
  86.         begin
  87.         window(27 + 12 * j, 5, 38 + 12 * j, tlength - 2);
  88.         writeln(j + 1);
  89.         xword:=$01BE + j shl 4;
  90.         xbyte:=part[xword];
  91.         case xbyte of
  92.           $00 : writeln('no');
  93.           $80 : writeln('yes')
  94.         else
  95.             writeln('(', hex(xbyte, 2), ')')
  96.         end;
  97.         xbyte:=part[xword + 4];
  98.         if xbyte > $00 then
  99.           begin
  100.           writeln(part[xword + 1]);
  101.           writeln(part[xword + 2] and $3F);
  102.           writeln(part[xword + 3] +
  103.             word(part[xword + 2] shr 6 * 256));
  104.           case xbyte of
  105.             $01 : Write('DOS-12');
  106.             $02 : Write('XENIX file');
  107.             $03 : Write('XENIX /usr');
  108.             $04 : Write('DOS-16');
  109.             $05 : Write('Ext DOS-16');
  110.             $06 : Write('Big DOS-16');
  111.             $07 : Write('OS/2 HPFS');
  112.             $08 : Write('AIX boot');
  113.             $09 : Write('AIX data');
  114.             $50 : Write('DskMngrR/O');
  115.             $51 : Write('Dsk Managr');
  116.             $52 : Write('CP/M');
  117.             $56 : Write('GB Vfeatre');
  118.             $61 : Write('Speedstor');
  119.             $63 : Write('SysV/386');
  120.             $64 : Write('NOVELL');
  121.             $75 : Write('PC/IX');
  122.             $80 : Write('Minix v1.3-');
  123.             $81 : Write('Minix v1.5+');
  124.             $DB : Write('CP/M');
  125.             $E1 : Write('SpdStr-12');
  126.             $E4 : Write('SpdStr-16');
  127.             $FE : Write('LANstep');
  128.             $FF : Write('BBT')
  129.           else
  130.             write('(', hex(xbyte, 2), ')')
  131.           end;
  132.           Writeln;
  133.           writeln(part[xword + 5]);
  134.           xbyte:=part[xword + 6];
  135.           writeln(xbyte and $3F);
  136.           writeln(cbw(part[xword + 7], xbyte shr 6));
  137.           xlong:=0;
  138.           for k:=11 downto 8 do
  139.             xlong:=xlong shl 8 + part[xword + k];
  140.           writeln(xlong);
  141.           xlong:=0;
  142.           for k:=15 downto 12 do
  143.             xlong:=xlong shl 8 + part[xword + k];
  144.           writeln(xlong)
  145.         end
  146.       else
  147.          for k:=1 to 9 do
  148.            writeln('-')
  149.       end;
  150.       xbool4:=false;
  151.       repeat
  152.         if i < $99 then
  153.           begin
  154.           inc(i);
  155.           with regs do
  156.             begin
  157.             AX:=$0201;
  158.             CX:=$0001;
  159.             DX:=i;
  160.             ES:=seg(part);
  161.             BX:=ofs(part);
  162.             intr($13, regs);
  163.             if nocarry(regs) then
  164.               begin
  165.               xbool4:=true;
  166.               pause1;
  167.               if endit then
  168.                 Exit;
  169.               end
  170.             end
  171.           end
  172.         else
  173.           begin
  174.           xbool3:=true;
  175.           xbool4:=true
  176.           end
  177.       until xbool4
  178.     until xbool3
  179.     end
  180.   else
  181.     writeln('(no fixed disks)')
  182.   end;
  183. end.